Trabalho final da disciplina

PROGRAMANDO IA COM R

Grupo2IA

July 3, 2018

Análise “Corridas de táxi de NY”

Alunos:

Nome RM
Augusto Cesar Ribeiro Freire 330695
Marcelo Muzilli 331136
Rafael da Silva Tomaz 330267
Renato Tavares da Silva 330659

Código Fonte

O código fonte do projeto está hospedado no Github no link:

Projeto Final taxi GitHub

Introdução

Será utilizado como base para as análises o documento: __“R__Trabalho_final_parte_1.pdf“__ com informações sobre as definições do projeto e o dataset “train.csv” fornecidos pelo professor, para o projeto através do portal do aluno.

O Dataset disponibilizado se refere a corridas de taxi de NYC, os campos do dataset:

Carregando variaveis e funçães necessrárias:

Para iniciar as análises será carregado algumas bibliotecas (pacotes) e dados de dependencias, conforme abaixo que se encontram no arquivo VariaveisGlobaisEFuncoesGlobais.R

# Carrega o arquivo necessarias em memória
source("VariaveisGlobaisEFuncoesGlobais.R")

# Instala pacotes adicionais e pacotes necessários
install_missing_packages()

# Faz o Load dos pacotes necessários para utilizar no projeto
load_packages()

# Faz Load dos arquivos necessários no projeto
load_file_dependenncies()

Dados do Dataset

  head(ds_taxi_train,5)
## # A tibble: 5 x 11
##   id    vendor_id pickup_datetime     dropoff_datetime    passenger_count
##   <chr>     <int> <dttm>              <dttm>                        <int>
## 1 id28…         2 2016-03-14 17:24:55 2016-03-14 17:32:30               1
## 2 id23…         1 2016-06-12 00:43:35 2016-06-12 00:54:38               1
## 3 id38…         2 2016-01-19 11:35:24 2016-01-19 12:10:48               1
## 4 id35…         2 2016-04-06 19:32:31 2016-04-06 19:39:40               1
## 5 id21…         2 2016-03-26 13:30:55 2016-03-26 13:38:10               1
## # ... with 6 more variables: pickup_longitude <dbl>,
## #   pickup_latitude <dbl>, dropoff_longitude <dbl>,
## #   dropoff_latitude <dbl>, store_and_fwd_flag <chr>, trip_duration <int>

Summary do Dataset

summary(ds_taxi_train) 
##       id              vendor_id     pickup_datetime              
##  Length:1458644     Min.   :1.000   Min.   :2016-01-01 00:00:17  
##  Class :character   1st Qu.:1.000   1st Qu.:2016-02-17 16:46:04  
##  Mode  :character   Median :2.000   Median :2016-04-01 17:19:40  
##                     Mean   :1.535   Mean   :2016-04-01 10:10:24  
##                     3rd Qu.:2.000   3rd Qu.:2016-05-15 03:56:08  
##                     Max.   :2.000   Max.   :2016-06-30 23:59:39  
##  dropoff_datetime              passenger_count pickup_longitude 
##  Min.   :2016-01-01 00:03:31   Min.   :0.000   Min.   :-121.93  
##  1st Qu.:2016-02-17 17:05:32   1st Qu.:1.000   1st Qu.: -73.99  
##  Median :2016-04-01 17:35:12   Median :1.000   Median : -73.98  
##  Mean   :2016-04-01 10:26:24   Mean   :1.665   Mean   : -73.97  
##  3rd Qu.:2016-05-15 04:10:51   3rd Qu.:2.000   3rd Qu.: -73.97  
##  Max.   :2016-07-01 23:02:03   Max.   :9.000   Max.   : -61.34  
##  pickup_latitude dropoff_longitude dropoff_latitude store_and_fwd_flag
##  Min.   :34.36   Min.   :-121.93   Min.   :32.18    Length:1458644    
##  1st Qu.:40.74   1st Qu.: -73.99   1st Qu.:40.74    Class :character  
##  Median :40.75   Median : -73.98   Median :40.75    Mode  :character  
##  Mean   :40.75   Mean   : -73.97   Mean   :40.75                      
##  3rd Qu.:40.77   3rd Qu.: -73.96   3rd Qu.:40.77                      
##  Max.   :51.88   Max.   : -61.34   Max.   :43.92                      
##  trip_duration    
##  Min.   :      1  
##  1st Qu.:    397  
##  Median :    662  
##  Mean   :    959  
##  3rd Qu.:   1075  
##  Max.   :3526282

Mapa de NYC (New York City)

Enriquecimento

Para enriquecimento do projeto conforme orientações definidas na Parte 1 (enriquecimento).

  data_wrangling_distance_calculate()
  data_wrangling_auxiliar_variables_definition()
  data_wrangling_quadrant_section_definition()

O Dataset será enriquecido com as seguintes variáveis: Diferença entre as duas métricas de distâncias Manhattan e Euclidiana

Enriquecimento (Continuação)

Para auxiliar nos gráficos será criado as variáveis:

Dados do Dataset após limpeza de dados

  head(ds_taxi_train,5)
## # A tibble: 5 x 28
##   id    vendor_id pickup_datetime     dropoff_datetime    passenger_count
##   <chr>     <int> <dttm>              <dttm>                        <int>
## 1 id28…         2 2016-03-14 17:24:55 2016-03-14 17:32:30               1
## 2 id23…         1 2016-06-12 00:43:35 2016-06-12 00:54:38               1
## 3 id38…         2 2016-01-19 11:35:24 2016-01-19 12:10:48               1
## 4 id35…         2 2016-04-06 19:32:31 2016-04-06 19:39:40               1
## 5 id21…         2 2016-03-26 13:30:55 2016-03-26 13:38:10               1
## # ... with 23 more variables: pickup_longitude <dbl>,
## #   pickup_latitude <dbl>, dropoff_longitude <dbl>,
## #   dropoff_latitude <dbl>, store_and_fwd_flag <chr>, trip_duration <int>,
## #   distancia.manhattan <dbl>, distancia.euclidiana <dbl>,
## #   distancia.manhattan.km <dbl>, distancia.manhattan.m <dbl>,
## #   distancia.euclidiana.km <dbl>, distancia.euclidiana.m <dbl>,
## #   trip_duration.minutes <int>, pickup_datetime.month <dbl>,
## #   pickup_datetime.day <int>, pickup_datetime.weekday <ord>,
## #   pickup_datetime.hour <int>, pickup_datetime.hour_period <dttm>,
## #   dropoff_datetime.month <dbl>, dropoff_datetime.day <int>,
## #   dropoff_datetime.weekday <ord>, dropoff_datetime.hour <int>,
## #   dropoff_datetime.day_period <dttm>

Summary do Dataset

  summary(ds_taxi_train) 
##       id              vendor_id     pickup_datetime              
##  Length:1458644     Min.   :1.000   Min.   :2016-01-01 00:00:17  
##  Class :character   1st Qu.:1.000   1st Qu.:2016-02-17 16:46:04  
##  Mode  :character   Median :2.000   Median :2016-04-01 17:19:40  
##                     Mean   :1.535   Mean   :2016-04-01 10:10:24  
##                     3rd Qu.:2.000   3rd Qu.:2016-05-15 03:56:08  
##                     Max.   :2.000   Max.   :2016-06-30 23:59:39  
##                                                                  
##  dropoff_datetime              passenger_count pickup_longitude 
##  Min.   :2016-01-01 00:03:31   Min.   :0.000   Min.   :-121.93  
##  1st Qu.:2016-02-17 17:05:32   1st Qu.:1.000   1st Qu.: -73.99  
##  Median :2016-04-01 17:35:12   Median :1.000   Median : -73.98  
##  Mean   :2016-04-01 10:26:24   Mean   :1.665   Mean   : -73.97  
##  3rd Qu.:2016-05-15 04:10:51   3rd Qu.:2.000   3rd Qu.: -73.97  
##  Max.   :2016-07-01 23:02:03   Max.   :9.000   Max.   : -61.34  
##                                                                 
##  pickup_latitude dropoff_longitude dropoff_latitude store_and_fwd_flag
##  Min.   :34.36   Min.   :-121.93   Min.   :32.18    Length:1458644    
##  1st Qu.:40.74   1st Qu.: -73.99   1st Qu.:40.74    Class :character  
##  Median :40.75   Median : -73.98   Median :40.75    Mode  :character  
##  Mean   :40.75   Mean   : -73.97   Mean   :40.75                      
##  3rd Qu.:40.77   3rd Qu.: -73.96   3rd Qu.:40.77                      
##  Max.   :51.88   Max.   : -61.34   Max.   :43.92                      
##                                                                       
##  trip_duration     distancia.manhattan distancia.euclidiana
##  Min.   :      1   Min.   : 0.00000    Min.   : 0.00000    
##  1st Qu.:    397   1st Qu.: 0.01123    1st Qu.: 0.01258    
##  Median :    662   Median : 0.02307    Median : 0.02122    
##  Mean   :    959   Mean   : 0.03603    Mean   : 0.03548    
##  3rd Qu.:   1075   3rd Qu.: 0.04585    3rd Qu.: 0.03841    
##  Max.   :3526282   Max.   :12.30804    Max.   :11.19260    
##                                                            
##  distancia.manhattan.km distancia.manhattan.m distancia.euclidiana.km
##  Min.   : 0.00000       Min.   :0.000e+00     Min.   : 0.00000       
##  1st Qu.: 0.01808       1st Qu.:1.808e-05     1st Qu.: 0.02025       
##  Median : 0.03713       Median :3.713e-05     Median : 0.03415       
##  Mean   : 0.05798       Mean   :5.798e-05     Mean   : 0.05710       
##  3rd Qu.: 0.07379       3rd Qu.:7.379e-05     3rd Qu.: 0.06181       
##  Max.   :19.80788       Max.   :1.981e-02     Max.   :18.01275       
##                                                                      
##  distancia.euclidiana.m trip_duration.minutes pickup_datetime.month
##  Min.   :0.000e+00      Min.   :    0.0       Min.   :1.000        
##  1st Qu.:2.025e-05      1st Qu.:    6.0       1st Qu.:2.000        
##  Median :3.414e-05      Median :   11.0       Median :4.000        
##  Mean   :5.710e-05      Mean   :   15.5       Mean   :3.517        
##  3rd Qu.:6.181e-05      3rd Qu.:   17.0       3rd Qu.:5.000        
##  Max.   :1.801e-02      Max.   :58771.0       Max.   :6.000        
##                                                                    
##  pickup_datetime.day  pickup_datetime.weekday pickup_datetime.hour
##  Min.   : 1.0        Domingo      :195366     Min.   : 0.00       
##  1st Qu.: 8.0        Segunda Feira:187418     1st Qu.: 9.00       
##  Median :15.0        Terca Feira  :202749     Median :14.00       
##  Mean   :15.5        Quarta Feira :210136     Mean   :13.61       
##  3rd Qu.:23.0        Quinta Feira :218574     3rd Qu.:19.00       
##  Max.   :31.0        Sexta Feira  :223533     Max.   :23.00       
##                      Sabado       :220868                         
##  pickup_datetime.hour_period   dropoff_datetime.month dropoff_datetime.day
##  Min.   :2016-01-01 00:00:17   Min.   :1.000          Min.   : 1.0        
##  1st Qu.:2016-02-17 16:46:04   1st Qu.:2.000          1st Qu.: 8.0        
##  Median :2016-04-01 17:19:40   Median :4.000          Median :15.0        
##  Mean   :2016-04-01 10:10:24   Mean   :3.517          Mean   :15.5        
##  3rd Qu.:2016-05-15 03:56:08   3rd Qu.:5.000          3rd Qu.:23.0        
##  Max.   :2016-06-30 23:59:39   Max.   :7.000          Max.   :31.0        
##                                                                           
##   dropoff_datetime.weekday dropoff_datetime.hour
##  Domingo      :197224      Min.   : 0.0         
##  Segunda Feira:187433      1st Qu.: 9.0         
##  Terca Feira  :202518      Median :14.0         
##  Quarta Feira :209790      Mean   :13.6         
##  Quinta Feira :217746      3rd Qu.:19.0         
##  Sexta Feira  :223031      Max.   :23.0         
##  Sabado       :220902                           
##  dropoff_datetime.day_period  
##  Min.   :2016-01-01 00:03:31  
##  1st Qu.:2016-02-17 17:05:32  
##  Median :2016-04-01 17:35:12  
##  Mean   :2016-04-01 10:26:24  
##  3rd Qu.:2016-05-15 04:10:51  
##  Max.   :2016-07-01 23:02:03  
## 

Análise básica de dados

Análise exploratória inicial:

Faça uma análise exploratória indicando:

Para melhorar a análise inicial, estamos avaliando o tempo de corridas com maior número e iremos remover as que tiverem as com menos tempo ou tempos muito grandes de corridas (outliers).

Variáveis do datase

  str(ds_taxi_train)
## Classes 'tbl_df', 'tbl' and 'data.frame':    1458644 obs. of  28 variables:
##  $ id                         : chr  "id2875421" "id2377394" "id3858529" "id3504673" ...
##  $ vendor_id                  : int  2 1 2 2 2 2 1 2 1 2 ...
##  $ pickup_datetime            : POSIXct, format: "2016-03-14 17:24:55" "2016-06-12 00:43:35" ...
##  $ dropoff_datetime           : POSIXct, format: "2016-03-14 17:32:30" "2016-06-12 00:54:38" ...
##  $ passenger_count            : int  1 1 1 1 1 6 4 1 1 1 ...
##  $ pickup_longitude           : num  -74 -74 -74 -74 -74 ...
##  $ pickup_latitude            : num  40.8 40.7 40.8 40.7 40.8 ...
##  $ dropoff_longitude          : num  -74 -74 -74 -74 -74 ...
##  $ dropoff_latitude           : num  40.8 40.7 40.7 40.7 40.8 ...
##  $ store_and_fwd_flag         : chr  "N" "N" "N" "N" ...
##  $ trip_duration              : int  455 663 2124 429 435 443 341 1551 255 1225 ...
##  $ distancia.manhattan        : num  0.0152 0.0265 0.0802 0.0155 0.0106 ...
##  $ distancia.euclidiana       : num  0.0177 0.0205 0.0599 0.0134 0.0107 ...
##  $ distancia.manhattan.km     : num  0.0244 0.0426 0.129 0.0249 0.017 ...
##  $ distancia.manhattan.m      : num  2.44e-05 4.26e-05 1.29e-04 2.49e-05 1.70e-05 ...
##  $ distancia.euclidiana.km    : num  0.0285 0.0329 0.0965 0.0216 0.0172 ...
##  $ distancia.euclidiana.m     : num  2.85e-05 3.29e-05 9.65e-05 2.16e-05 1.72e-05 ...
##  $ trip_duration.minutes      : int  7 11 35 7 7 7 5 25 4 20 ...
##  $ pickup_datetime.month      : num  3 6 1 4 3 1 6 5 5 3 ...
##  $ pickup_datetime.day        : int  14 12 19 6 26 30 17 21 27 10 ...
##  $ pickup_datetime.weekday    : Ord.factor w/ 7 levels "Domingo"<"Segunda Feira"<..: 2 1 3 4 7 7 6 7 6 5 ...
##  $ pickup_datetime.hour       : int  17 0 11 19 13 22 22 7 23 21 ...
##  $ pickup_datetime.hour_period: POSIXct, format: "2016-03-14 17:24:55" "2016-06-12 00:43:35" ...
##  $ dropoff_datetime.month     : num  3 6 1 4 3 1 6 5 5 3 ...
##  $ dropoff_datetime.day       : int  14 12 19 6 26 30 17 21 27 10 ...
##  $ dropoff_datetime.weekday   : Ord.factor w/ 7 levels "Domingo"<"Segunda Feira"<..: 2 1 3 4 7 7 6 7 6 5 ...
##  $ dropoff_datetime.hour      : int  17 0 12 19 13 22 22 8 23 22 ...
##  $ dropoff_datetime.day_period: POSIXct, format: "2016-03-14 17:32:30" "2016-06-12 00:54:38" ...

Summary do dataset por minutos de viagem

  # Gerando valores por minutos
  data <- 
    ds_taxi_train %>% 
      count(trip_duration.minutes , sort = TRUE)

  # Summary dos dados
  summary(data)
##  trip_duration.minutes       n        
##  Min.   :    0.0       Min.   :    1  
##  1st Qu.:  114.2       1st Qu.:    1  
##  Median :  474.0       Median :    2  
##  Mean   :  971.5       Mean   : 3185  
##  3rd Qu.: 1285.5       3rd Qu.:   32  
##  Max.   :58771.0       Max.   :89942

Gráfico de análise de viagens por minutos

  ggplot(aes(x=trip_duration.minutes, y=n ), data=data) +
    geom_line(alpha = 0.5, size = 1, position = 'jitter') +
    scale_x_continuous(limits = c(0.2, 20),
       breaks = c(1, 2, 3, 4, 5,6,7,8,9,10,11,12,13,14,15,20)) + 
    scale_y_continuous() +
    geom_smooth(method = "lm") +
    xlab("Minutos de tempo de corrida") +
    ylab("Quantidade de corridas") +
    ggtitle("Gráfico de duração de viagem de corridas pelo modelo linear")

Após analisar o gráfico acima, entendemos que o tempo com dados suficientes para análise com maior número de corridas estão com duração em minutos entre 4 e 13 minutos.

Subset

Filtrar o dataset para análise sobre um conjunto menor de dados, que contenha pelo menos 5000 observações.

Para a análise iremos utilizar apenas a região referênte a Manhattan, conforme o link wikipédia, em 2017 possui uma população de aproximadamente 1.664.727 habitantes, com uma área total de:

Os códigos de área desta região de New York possuem os formatos: 100xx, 101xx, 102xx.

## [1] "O Dataset original possui:  28  variáveis e  1458644  linhas"

Mapa da região a ser analisada

O Mapa da Região de Manhattan que serão utilizados na análise será conforme abaixo, com posicionamento central em (latitude 40.785091 e longitude -73.968285 ) como segue abaixo:

  # Gerando gráfico da regiao
  load_map_dependecy()

  # Imprimindo gráfico da região
  map

O Mapa acima possui longitudes entre (-74.07798 e -73.85825) e latitude entre (40.70172 e 40.86809), devido a isso, será considerado corridas que possuam inicio e fim dentro desses posicionamentos de longitude e latitude.

Dados da região analisada pelo mapa

  #Dados de longitude e latitude conforme definição
  map$data
##         lon      lat
## 1 -74.07798 40.70172
## 2 -73.85825 40.70172
## 3 -74.07798 40.86809
## 4 -73.85825 40.86809

Normalização dos dados do dataset para gerar o subset

Normalizando o Dataset para conter apenas os dados dentro dos limiares de longitude e latitude. Outra normalização que iremos realizar será de tempo de corrida, iremos utilizar para análise apenas corridas com tempo de duração maior ou igual 4 minutos e menor ou igual a 13 minutos.

  normalization_dataset_longitude_latitude_between_min_and_max()

  # Valor Em Minutos
  normalization_dataset_trip_duration_between_min_and_max(4, 13)
  
  # Validação dos dados do subset
  paste("Após a normalizaçãa de latitude e longitude e duração em minutos o Dataset possui: ", length(ds_taxi_train_subset),
        " variáveis e ", nrow(ds_taxi_train_subset), " linhas")
## [1] "Após a normalizaçãa de latitude e longitude e duração em minutos o Dataset possui:  28  variáveis e  759372  linhas"
  # Removendo variaveis:
  rm(ds_taxi_train)

Análises gráficas

Sumarização de contagem de corridas de Pickup e Dropoff por Mês

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.month , sort = TRUE) %>%
        rename(x_value = pickup_datetime.month, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.month , sort = TRUE) %>%
        rename(x_value = dropoff_datetime.month, dropoff_count = n)
      
      , by="x_value", all = TRUE
    )
  
  # Sumarização
  data_type <- 'Mês'
  summarise_by_data(data, data_type, 12)
##     x_value     pickup_count    dropoff_count   
##  Min.   :1.0   Min.   :117293   Min.   :    34  
##  1st Qu.:2.5   1st Qu.:124397   1st Qu.:120698  
##  Median :4.0   Median :126952   Median :125263  
##  Mean   :4.0   Mean   :126562   Mean   :108482  
##  3rd Qu.:5.5   3rd Qu.:128725   3rd Qu.:128692  
##  Max.   :7.0   Max.   :135315   Max.   :135296  
##                NA's   :1

Gráficos de corridas por período por mês

  #Gerando dados de labels
  y_lab <- 'Quantidade de corridas'
  x_lab <- data_type
  title <- 'Gráfico de linha temporal por mês'
  x_breaks <- seq(1,6,1)
  y_limits <- c(117000, 136000)
  y_breaks <- seq(117000, 136000, 2500)
  
  ploting_data(data, x_breaks,  y_limits, y_breaks, x_lab, y_lab, title)

Sumarização de contagem de corridas de Pickup e Dropoff por Período Semanal

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.weekday , sort = TRUE) %>%
        rename(x_value = pickup_datetime.weekday, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.weekday , sort = TRUE) %>%
        rename(x_value = dropoff_datetime.weekday, dropoff_count = n)
      
      , by="x_value", all = TRUE
    )
  
  # Sumarização
  data_type <- "Dia da semana"
  summarise_by_data(data, data_type, 12)
##           x_value   pickup_count    dropoff_count   
##  Domingo      :1   Min.   :100851   Min.   :100821  
##  Segunda Feira:1   1st Qu.:105232   1st Qu.:105140  
##  Terca Feira  :1   Median :107183   Median :107753  
##  Quarta Feira :1   Mean   :108482   Mean   :108482  
##  Quinta Feira :1   3rd Qu.:110959   3rd Qu.:110794  
##  Sexta Feira  :1   Max.   :118956   Max.   :118930  
##  Sabado       :1

Gráficos de corridas por dia da semana

  #Gerando dados de labels
  x_lab <- data_type
  y_lab <- 'Quantidade de corridas'
  title <- 'Gráfico de linha temporal por dia da Semana'
  y_limits <- c(100000, 120000)
  y_breaks <- seq(100000, 120000, 2500)
  
  ploting_data(data, NULL,  y_limits, y_breaks, x_lab, y_lab, title)

Gráfico consolidado

ggplot(data = data, aes(x=x_value,group = 1)) +
  geom_line(mapping = aes(y=pickup_count, color="Pick UP"), size=1) +
  geom_line(mapping = aes(y=dropoff_count, color="Drop Off"), size=1) +
  scale_color_manual(values = c(
    'Pick UP' = 'darkblue',
    'Drop Off' = 'red')) +
  labs(color = 'Labels') + 
  scale_y_continuous(limits = y_limits, breaks = y_breaks) + 
  geom_hline(yintercept = median(data$pickup_count), alpha=1, linetype=2) +
  geom_hline(yintercept = median(data$dropoff_count), alpha=1, linetype=2) +
  xlab(x_lab) +
  ylab(y_lab) +
  ggtitle(paste(title, " - Pickup e Dropoff"))

Sumarização de contagem de corridas de Pickup e Dropoff por dia do mês

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.day , sort = TRUE) %>%
        rename(x_value = pickup_datetime.day, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.day , sort = TRUE) %>%
        rename(x_value = dropoff_datetime.day, dropoff_count = n)
      
      , by="x_value", all = TRUE
    )
  
  # Sumarização
  data_type <- "Dia do Mês"
  summarise_by_data(data, data_type, 12)
##     x_value      pickup_count   dropoff_count  
##  Min.   : 1.0   Min.   :12021   Min.   :12038  
##  1st Qu.: 8.5   1st Qu.:24324   1st Qu.:24328  
##  Median :16.0   Median :25096   Median :25061  
##  Mean   :16.0   Mean   :24496   Mean   :24496  
##  3rd Qu.:23.5   3rd Qu.:25823   3rd Qu.:25843  
##  Max.   :31.0   Max.   :26584   Max.   :26544

Gráficos de corridas por período por dia do mês

  #Gerando dados de labels
  y_lab <- 'Quantidade de corridas'
  x_lab <- data_type
  title <- 'Gráfico de linha temporal por dia do mês'
  x_breaks <- seq(1,31,1)
  y_limits <- c(12000, 27000)
  y_breaks <- seq(12000, 27000, 1500)
  
  ploting_data(data, x_breaks,  y_limits, y_breaks, x_lab, y_lab, title)

Gráficos de corridas por período por dia do mês e por Mês

  # Gerando dados consolidados
  data <- 
    merge(
      ds_taxi_train_subset %>%  
        count(pickup_datetime.day, pickup_datetime.month , sort = TRUE) %>%
        rename(x_value = pickup_datetime.day, facet_wrap = pickup_datetime.month, pickup_count = n) ,
      
      ds_taxi_train_subset %>% 
        count(dropoff_datetime.day, dropoff_datetime.month, sort = TRUE) %>%
        rename(x_value = dropoff_datetime.day, facet_wrap = dropoff_datetime.month, dropoff_count = n) , 
      by=c("facet_wrap", "x_value"), all = TRUE
    )
  
  # Sumarização
  data_type <- "Dia do Mês e Mês"
  summarise_by_data(data, data_type, 10)
##    facet_wrap       x_value      pickup_count  dropoff_count 
##  Min.   :1.000   Min.   : 1.0   Min.   : 867   Min.   :  34  
##  1st Qu.:2.000   1st Qu.: 8.0   1st Qu.:3892   1st Qu.:3886  
##  Median :4.000   Median :16.0   Median :4198   Median :4180  
##  Mean   :3.519   Mean   :15.6   Mean   :4172   Mean   :4150  
##  3rd Qu.:5.000   3rd Qu.:23.0   3rd Qu.:4473   3rd Qu.:4470  
##  Max.   :7.000   Max.   :31.0   Max.   :5303   Max.   :5294  
##                                 NA's   :1

Gráficos de corridas por período por dia do mês

  #Gerando dados de labels
  y_lab <- 'Quantidade de corridas'
  x_lab <- data_type
  title <- 'Gráfico de linha temporal por dia do mês e Mês'
  x_breaks <- seq(1,31,2)
  y_limits <- c(0, 5300)
  y_breaks <- seq(0, 5300, 750)
  
  ploting_data(data, x_breaks,  y_limits, y_breaks, x_lab, y_lab, title, TRUE)

Gráficos de mapa de densidade

Clusterização (aprendizado não-supervisionado)

Nesse passo será criado uma coluna de categorização para Pickup, com os clusters encontrados.

  set.seed(20)
  
  clusters <- kmeans(ds_taxi_train_subset[,6:7], 5)
  
  #Salvar o numero do cluster na nova coluna -> 'category_pickup'
  ds_taxi_train_subset$category_pickup <- as.factor(clusters$cluster)
  str(clusters)
## List of 9
##  $ cluster     : int [1:759372] 2 5 3 1 5 2 4 1 4 5 ...
##  $ centers     : num [1:5, 1:2] -74 -74 -74 -74 -74 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:5] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:2] "pickup_longitude" "pickup_latitude"
##  $ totss       : num 589
##  $ withinss    : num [1:5] 69.5 29.2 13.9 12.5 13.5
##  $ tot.withinss: num 139
##  $ betweenss   : num 450
##  $ size        : int [1:5] 147196 238001 107947 148132 118096
##  $ iter        : int 7
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

Nesse passo será criado uma coluna de categorização para Dropoff, com os clusters encontrados.

  set.seed(20)
  
  clusters <- kmeans(ds_taxi_train_subset[,8:9], 5)
  
  #Salvar o numero do cluster na coluna -> 'category_dropoff'
  ds_taxi_train_subset$category_dropoff <- as.factor(clusters$cluster)
str(clusters)
## List of 9
##  $ cluster     : int [1:759372] 1 3 3 1 4 1 5 1 3 5 ...
##  $ centers     : num [1:5, 1:2] -74 -74 -74 -74 -74 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:5] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:2] "dropoff_longitude" "dropoff_latitude"
##  $ totss       : num 675
##  $ withinss    : num [1:5] 35.2 82.1 13.2 14 19.8
##  $ tot.withinss: num 164
##  $ betweenss   : num 511
##  $ size        : int [1:5] 242132 153865 97423 149444 116508
##  $ iter        : int 5
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

Mapa de Calor

##     X1    X2    X3    X4     X5     X6     X7     X8     X9     X10   
## Y10 "q10" "q46" "q82" "q118" "q154" "q190" "q226" "q262" "q298" "q334"
## Y9  "q9"  "q45" "q81" "q117" "q153" "q189" "q225" "q261" "q297" "q333"
## Y8  "q8"  "q44" "q80" "q116" "q152" "q188" "q224" "q260" "q296" "q332"
## Y7  "q7"  "q43" "q79" "q115" "q151" "q187" "q223" "q259" "q295" "q331"
## Y6  "q6"  "q42" "q78" "q114" "q150" "q186" "q222" "q258" "q294" "q330"
## Y5  "q5"  "q41" "q77" "q113" "q149" "q185" "q221" "q257" "q293" "q329"
## Y4  "q4"  "q40" "q76" "q112" "q148" "q184" "q220" "q256" "q292" "q328"
## Y3  "q3"  "q39" "q75" "q111" "q147" "q183" "q219" "q255" "q291" "q327"
## Y2  "q2"  "q38" "q74" "q110" "q146" "q182" "q218" "q254" "q290" "q326"
## Y1  "q1"  "q37" "q73" "q109" "q145" "q181" "q217" "q253" "q289" "q325"
##    names  x   y    x.from      x.to    y.from      y.to  x.center
## 1     q1 X1  Y1 -74.07798 -74.07198 -74.07798 -74.07198 -74.07498
## 2     q2 X1  Y2 -74.07798 -74.07198 -74.07198 -74.06598 -74.07498
## 3     q3 X1  Y3 -74.07798 -74.07198 -74.06598 -74.05998 -74.07498
## 4     q4 X1  Y4 -74.07798 -74.07198 -74.05998 -74.05398 -74.07498
## 5     q5 X1  Y5 -74.07798 -74.07198 -74.05398 -74.04798 -74.07498
## 6     q6 X1  Y6 -74.07798 -74.07198 -74.04798 -74.04198 -74.07498
## 7     q7 X1  Y7 -74.07798 -74.07198 -74.04198 -74.03598 -74.07498
## 8     q8 X1  Y8 -74.07798 -74.07198 -74.03598 -74.02998 -74.07498
## 9     q9 X1  Y9 -74.07798 -74.07198 -74.02998 -74.02398 -74.07498
## 10   q10 X1 Y10 -74.07798 -74.07198 -74.02398 -74.01798 -74.07498
## 11   q11 X1 Y11 -74.07798 -74.07198 -74.01798 -74.01198 -74.07498
## 12   q12 X1 Y12 -74.07798 -74.07198 -74.01198 -74.00598 -74.07498
## 13   q13 X1 Y13 -74.07798 -74.07198 -74.00598 -73.99998 -74.07498
## 14   q14 X1 Y14 -74.07798 -74.07198 -73.99998 -73.99398 -74.07498
## 15   q15 X1 Y15 -74.07798 -74.07198 -73.99398 -73.98798 -74.07498
## 16   q16 X1 Y16 -74.07798 -74.07198 -73.98798 -73.98198 -74.07498
## 17   q17 X1 Y17 -74.07798 -74.07198 -73.98198 -73.97598 -74.07498
## 18   q18 X1 Y18 -74.07798 -74.07198 -73.97598 -73.96998 -74.07498
## 19   q19 X1 Y19 -74.07798 -74.07198 -73.96998 -73.96398 -74.07498
## 20   q20 X1 Y20 -74.07798 -74.07198 -73.96398 -73.95798 -74.07498
## 21   q21 X1 Y21 -74.07798 -74.07198 -73.95798 -73.95198 -74.07498
## 22   q22 X1 Y22 -74.07798 -74.07198 -73.95198 -73.94598 -74.07498
## 23   q23 X1 Y23 -74.07798 -74.07198 -73.94598 -73.93998 -74.07498
## 24   q24 X1 Y24 -74.07798 -74.07198 -73.93998 -73.93398 -74.07498
## 25   q25 X1 Y25 -74.07798 -74.07198 -73.93398 -73.92798 -74.07498
## 26   q26 X1 Y26 -74.07798 -74.07198 -73.92798 -73.92198 -74.07498
## 27   q27 X1 Y27 -74.07798 -74.07198 -73.92198 -73.91598 -74.07498
## 28   q28 X1 Y28 -74.07798 -74.07198 -73.91598 -73.90998 -74.07498
## 29   q29 X1 Y29 -74.07798 -74.07198 -73.90998 -73.90398 -74.07498
## 30   q30 X1 Y30 -74.07798 -74.07198 -73.90398 -73.89798 -74.07498
## 31   q31 X1 Y31 -74.07798 -74.07198 -73.89798 -73.89198 -74.07498
##     y.center
## 1  -74.07498
## 2  -74.06898
## 3  -74.06298
## 4  -74.05698
## 5  -74.05098
## 6  -74.04498
## 7  -74.03898
## 8  -74.03298
## 9  -74.02698
## 10 -74.02098
## 11 -74.01498
## 12 -74.00898
## 13 -74.00298
## 14 -73.99698
## 15 -73.99098
## 16 -73.98498
## 17 -73.97898
## 18 -73.97298
## 19 -73.96698
## 20 -73.96098
## 21 -73.95498
## 22 -73.94898
## 23 -73.94298
## 24 -73.93698
## 25 -73.93098
## 26 -73.92498
## 27 -73.91898
## 28 -73.91298
## 29 -73.90698
## 30 -73.90098
## 31 -73.89498

Modelagem ML

Foi utilizado tecnicas de noramlização de dados e limpeza de dados para criação de novas variáveis para adequar os dados para utilizar no modelo.

Para o modelo iremos utilizar 70% dos dados para treinamento e 30% dos dados para teste:

os dados utilizados para modelagem da predição serão

Dados de entradas (Feature Engineering) Pickups (longitude, latitude) Dropoff (longitude, latitude) week_day period_of_day (manha_tarde_noite)

Processamento: Algoritmo PCA com regressão linear

Dados de saída(s) Tempo de corrida Distância

Definir processamento Avaliação Matriz de confusão (por Acurácia)

Modelo Predicao

Modelo Predicao